home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
BBS Toolkit
/
BBS Toolkit.iso
/
rbbs_pc
/
ugly174.zip
/
RSB2UGLY.MRG
< prev
next >
Wrap
Text File
|
1992-07-05
|
50KB
|
1,290 lines
* ------------[ BLED merge (c) Ken Goosens ]-------------
* Merge this against RELEASE\RBBSSUB2.BAS to produce RBBSSUB2.BAS
* RELEASE\RBBSSUB2.BAS: Date 6-20-1992 Size 140946 bytes
* ------------[ Created 07-04-1992 19:43:21 ]------------
* REPLACING old line(s) by new
109 ' $SUBTITLE: 'VarInit - subroutine to initialize system variables'
' $PAGE
'
' NAME -- VarInit
'
' INPUTS -- PARAMETER MEANING
' NONE
'
' OUTPUTS -- NONE
'
' PURPOSE -- To initialize system variable
'
SUB VarInit STATIC
DEF SEG ' Point to BASIC
WIDTH 80 ' Set Screen Width
KEY OFF ' Line 25 turned off
' ********************* Variable Definitions *******************************
ZMsgDim = 99
WasMM = 999
WasBX = 75
WasJ = 60
REDIM ZOptSec(WasJ)
DIM ZWorkAra$(WasJ)
DIM ZGSRAra$(WasJ)
DIM ZCategoryName$(WasBX),ZCategoryCode$(WasBX),ZCategoryDesc$(WasBX)
DIM ZOutTxt$(ZMsgDim) ' Message line table
DIM ZUserIn$(ZMsgDim) ' Message line table
DIM ZMsgPtr(WasMM,2) ' Message pointers
ZAcknowledge$ = CHR$(6)
ZAckChar$ = "C" + _
ZAcknowledge$
ZActiveMenu$ = "B"
ZActiveMessage$ = CHR$(225)
ZBackSpace$ = CHR$(8) + _
CHR$(32) + _
CHR$(8)
ZBackArrow$ = CHR$(29) + _
CHR$(32) + _
CHR$(29)
ZBaudRates$ = " 300 450 1200 2400 4800 7200 96001200014400168001920038400"
ZBellRinger$ = CHR$(7)
ZBulletinMenu$ = ""
ZWasCL = 24
ZCancel$ = CHR$(24)
ZColorReset$ = CHR$(27) + _
"[00;37;40m"
ZConfigFileName$ = "RBBS-PC.DEF"
ZCarriageReturn$ = CHR$(13)
ZDeletedMsg$ = CHR$(226)
ZEndTransmission$ = CHR$(4)
ZEscape$ = CHR$(27)
ZExpectActiveModem = 0
ZFalse = 0
ZF1Key = 59
ZF10Key = 68
ZConfName$ = "MAIN"
CALL SetHiLite (ZTrue)
ZHomeConf$ = ""
ZInConfMenu = -1
ZLastCommand$ = "M "
ZLimitMinsPerSession = 0
ZLineFeed$ = CHR$(10)
ZLineFeeds = NOT ZFalse
ZLineEditChk$ = CHR$(9) + _
ZLineFeed$ + _
CHR$(11) + _
CHR$(12) + _
CHR$(127) + _
CHR$(8) + _
ZBellRinger$ + _
CHR$(26) + _
CHR$(227)
ZLineMes$ = SPACE$(78) ' fixed length string workspace
ZLockStatus$ = "UM UU UB UD"
ZMenuIndex = 2
ZNAK$ = CHR$(21)
ZNoAdvance = ZFalse
ZPageLength = 23
ZParseOff = ZFalse
* ------[ first line different ]------
ZPressEnter$ = " (Press [ENTER] to Quit)" ' UG070501
ZPressEnterExpert$ = " ([ENTER] Quits)" ' UG070501
ZPressEnterNovice$ = ZPressEnter$
ZPrivateDoor = ZFalse
ZRightMargin = 72
ZReturnLineFeed$ = ZCarriageReturn$ + _
ZLineFeed$
ZSmartTable$ = "CS PB NS FN LN SL DT TM TR TE TL RP RR CT " + _
"C1 C2 C3 C4 C0 DD BD DB UB DL UL FI VY VN " + _
"TY TN BN ND FS LS CN"
ZStartOfHeader$ = CHR$(1)
ZTimeLoggedOn$ = SPACE$(8)
ZTrue = NOT ZFalse
ZUpInc = -1
ZXOff$ = CHR$(19)
ZXOn$ = CHR$(17)
ZInterrupOn$ = CHR$(11) + ZCancel$ + ZXOff$ + ZXOn$ + ZCarriageReturn$
ZOptionEnd$ = ZReturnLineFeed$ + " ,("
ZCrLf$ = ZCarriageReturn$ + ZLineFeed$
ZVersionID$ = "17.4A/0704"
ZWasLG$(1) = "Registration Check Failed"
ZWasLG$(2) = "Sysop name attempted"
ZWasLG$(3) = "Locked out attempt"
ZWasLG$(4) = "Password Attempt Failed"
ZWasLG$(5) = "Auto Lockout done"
ZWasLG$(6) = "Name in use on another Node!"
ZWasLG$(7) = ""
ZWasLG$(8) = "Locked reason read!"
ZWasLG$(9) = "Expired Registration"
CALL GetCommand (ZDebug,ZNetTime$,ZNetBaud$,ZNetReliable$)
ZSubParm = 1
CALL ReadDef (ZConfigFileName$)
REDIM ZWorkAra$(ZMaxWorkVar)
REDIM ZGSRAra$(ZMaxWorkVar)
ZUseTPut = (ZUpperCase OR ZXOnXOff)
ZOrigCallers$ = ZCallersFile$
ZOrigMsgFile$ = ZMainMsgFile$
ZOrigUserFile$ = ZMainUserFile$
ZOrigSysopFN$ = ZSysopFirstName$
ZOrigSysopLN$ = ZSysopLastName$
ZPromptBell = ZPromptBellDef
ZSecretName$ = ZSysopPswd1$ + " " + ZSysopPswd2$
END SUB
'
* REPLACING old line(s) by new
* ------[ first line different ]------
675 ZOutTxt$ = "Enter a Password" ' UG070501
ZHidden = ZTrue
CALL PopCmdStack
IF ZSubParm < 0 THEN _
ZPswdFailed = ZTrue : _
EXIT SUB
ZHidden = ZFalse
ZWasZ$ = ZUserIn$
* REPLACING old line(s) by new
* ------[ first line different ]------
680 CALL QuickTPut1 ("Sorry, Wrong Password.") ' UG070501
ZLastIndex = 0
IF NOT ZMsgPswd THEN _
CALL UpdtCalr (ZActiveUserName$+" PW fail: " + ZWasZ$,1)
GOTO 670
END SUB
* REPLACING old line(s) by new
1331 IF SotMenu THEN _
ZFileName$ = HelpMenu$ : _
GOSUB 1350 : _
SotMenu = ZFalse
ZAnsIndex = 1
* ------[ first line different ]------
ZOutTxt$ = "Display Help for What (HELP for Menu)" + _ ' UG070501
ZPressEnterExpert$
ZSubParm = 1
CALL UglyTGet ' UG070501
IF ZSubParm = -1 THEN _
EXIT SUB
IF ZWasQ = 0 THEN _
EXIT SUB
ZLastIndex = ZWasQ
* REPLACING old line(s) by new
1336 IF NOT ZOK THEN _
* ------[ first line different ]------
ZOutTxt$ = "Sorry, No Help Found for " + _
ZWasZ$ + "." : _ ' UG070501
CALL QuickTPut2 (ZOutTxt$) : _ ' UG070501
CALL UpdtCalr (ZOutTxt$,2)
ZAnsIndex = ZAnsIndex + 1
IF ZAnsIndex <= ZLastIndex THEN _
GOTO 1332
IF FastHelp THEN _
FastHelp = ZFalse : _
EXIT SUB
GOTO 1331
* REPLACING old line(s) by new
1350 CALL Graphic (ZFileName$)
* ------[ first line different ]------
IF NOT ZOK THEN _ ' UG070501
RETURN ' UG070501
CALL BufFile (ZFileName$,WasX)
RETURN
END SUB
* REPLACING old line(s) by new
1380 ' $SUBTITLE: 'VIOLATION - handles all security violations'
' $PAGE
'
' NAME -- SecViolation
'
' INPUTS -- PARAMETER MEANING
'
' OUTPUTS -- ZCursorLine CURRENT LINE ON SCREEN
' ZCursorRow CURRENT ROW ON ZCursorLine
'
' PURPOSE -- Inform caller of security violation, augment count of
' violations and determine whether too many occurred.
'
SUB SecViolation STATIC
CALL FlushKeys
CALL BufFile (ZSecVioHelp$,WasX)
IF NOT ZOK THEN _
* ------[ first line different ]------
CALL QuickTPut2 ("Sorry, a Higher Security Level is Required.") ' UG070501
CALL UpdtCalr ("SV!-" + ZViolation$,2)
ZLastIndex = 0
CALL Muzak (3)
ZViolationsThisSession = ZViolationsThisSession + 1
IF ZMaxViolations = 0 OR ZViolationsThisSession <= ZMaxViolations THEN _
EXIT SUB
* REPLACING old line(s) by new
1385 IF ZUserFileIndex < 1 THEN _
EXIT SUB
* ------[ first line different ]------
ZOutTxt$ = "Security Violation! SysOp Can Reinstate You." ' UG070501
IF ZUserSecLevel <= ZMinLogonSec THEN _
ZOutTxt$ = "" : _
ZUserSecLevel = ZUserSecLevel - 1 _
ELSE ZUserSecLevel = ZMinLogonSec
ZDenyAccess = ZTrue
END SUB
* REPLACING old line(s) by new
1450 IF ZCR <> 1 THEN _
* ------[ first line different ]------
CALL SkipLine (1) ' UG070501
IF ZCR > 1 THEN _ ' UG070501
CALL SkipLine (1) ' UG070501
* REPLACING old line(s) by new
* ------[ first line different ]------
1476 IF ASC(ZWasY$) < 127 THEN ' UG070509
ZCommPortStack$ = ZCommPortStack$ + ZWasY$
IF ZTurboKey OR (NOT ZTurboKey AND ZWasY$ = ZCarriageReturn$) THEN ' UG070509
ZRet = ZTrue ' UG070509
END IF ' UG070509
END IF ' UG070509
RETURN
END SUB
* REPLACING old line(s) by new
1478 ' $SUBTITLE: 'QuickTPut - subroutine to quickly write to terminal'
' $PAGE
'
' NAME -- QuickTPut
'
' INPUTS -- PARAMETER MEANING
' Strng$ STRING TO WRITE OUT
' NumReturns NUMBER OF CARRIAGE RETURNS
'
' OUTPUTS -- NONE
'
' PURPOSE -- Subroutine to quickly write to the terminal. This is
' different from "TPut" in the things it doesn't do:
' A.) No function key check,
' B.) No conversion to upper case,
' C.) No check for carrier present
' D.) No check for imbedded carriage return in "Strng$"
' E.) No support for XON/XOff
'
SUB QuickTPut (Strng$,NumReturns) STATIC
IF ZSubParm < 0 THEN _
EXIT SUB
IF ZUseTPut THEN _
ZOutTxt$ = Strng$ : _
ZSubParm = 4 : _
CALL TPut : _
CALL SkipLine (NumReturns) : _
EXIT SUB
CALL PutCom (Strng$)
LOCATE ,,1
CALL LPrnt (Strng$,0)
CALL SkipLine (NumReturns)
END SUB
SUB QuickTPut1 (Strng$) STATIC
CALL QuickTPut (Strng$,1)
END SUB
* ------[ first line different ]------
SUB QuickTPut2 (Strng$) STATIC ' UG070501
CALL QuickTPut (Strng$,2) ' UG070501
END SUB ' UG070501
* REPLACING old line(s) by new
1500 CALL Carrier
IF ZSubParm = -1 THEN _
EXIT SUB
ZLinesPrinted = 0
ZDisplayAsUnit = ZFalse
InStack = ZFalse
GOSUB 1580
ZWasA = 0
ZWasB = 0
ZWasC = 0
ZWasQ = 1
ZStoreParseAt = 1
ZYes = ZFalse
ZUserIn$ = ""
SleepWarn = ZTrue
ZNo = ZFalse
ZNonStop = (ZPageLength < 1)
IF ZOutTxt$ = "" THEN _
GOTO 1525
* ------[ first line different ]------
IsMore = (LEFT$(ZOutTxt$,4) = "More") OR (LEFT$(ZOutTxt$,6) = "Press ") ' UG070510
IF ZHidden THEN _
ZOutTxt$ = ZOutTxt$ + " (dots will echo)" ' UG070501
IF (NOT ZVerifying) OR HoldA$ = "" THEN _
CALL ColorPrompt (ZOutTxt$) : _
ZOutTxt$ = ZOutTxt$ + _
MID$("? : ",2*ZTurboKey+1,2) : _ ' UG070501
HoldA$ = ZOutTxt$ _
ELSE ZOutTxt$ = HoldA$
ZSubParm = 4
StopSave = ZStopInterrupts
ZStopInterrupts = ZTrue
CALL TPut
ZStopInterrupts = StopSave
IF ZSubParm = -1 OR ZFunctionKey <> 0 THEN _
EXIT SUB
* REPLACING old line(s) by new
1537 CALL CheckTime(ZAutoLogoff!, TempElapsed!, 3)
IF TempElapsed! < 30 THEN _
IF TempElapsed! <= 0 THEN _
* ------[ first line different ]------
CALL SkipLine (2) : _ ' UG070501
ZSubParm = -1 : _
ZNo = ZTrue : _
ZRet = ZTrue : _
ZSleepDisconnect = NOT ZAutoLogoffReq : _
IF ZAutoLogoffReq THEN _
CALL UpdtCalr ("Auto-logoff",1): _
EXIT SUB _
ELSE CALL UpdtCalr ("Sleep disconnect",1) : _
EXIT SUB _
ELSE IF SleepWarn THEN _
SleepWarn = ZFalse : _
Temp! = TempElapsed! : _
CALL SkipLine (1) : _ ' UG070501
ZOutTxt$ = "Logging You Off. Press [ENTER] to Abort." : _ ' UG070501
CALL RingCaller : _ ' UG070501
CALL QuickTput ("Auto-Logoff in 30",0) _ ' UG070501
ELSE IF Temp! - TempElapsed! > 1.0 THEN _
CALL QuickTPut (ZBackSpace$+ZBackSpace$,0) : _
CALL QuickTPut (RIGHT$(STR$(CINT(TempElapsed!)),2),0) : _
Temp! = TempElapsed! ' UG070501
CALL FindFKey
IF ZSubParm < 0 THEN _
EXIT SUB
* REPLACING old line(s) by new
1545 WasX$ = ZWasY$
* ------[ first line different ]------
IF ZFossil AND _ ' UG070510
NOT IsMore AND _ ' UG070510
(ZTurboKey OR (NOT ZTurboKey AND ZWasY$ = ZCarriageReturn$)) THEN ' UG070510
CALL FosTxPurge(ZComPort) ' UG070510
CALL PutCom(ZEmphasizeOff$ + ZEmphasizeOff$) ' UG070510
END IF ' UG070510
ZAutoLogoffReq = ZFalse
IF INSTR(ZLineEditChk$,ZWasY$) > 5 _
GOTO 1635
IF ZWasY$ < " " AND ZWasY$ <> ZCarriageReturn$ THEN _
GOTO 1525
IF ZWasY$ = "^" THEN _
GOTO 1525
IF ZWasY$ = ZCarriageReturn$ THEN _
GOTO 1547 _
ELSE GOSUB 1550
IF ZTurboKey < 1 THEN _
GOTO 1546
IF ZWasY$ = " " THEN _
ZWasY$ = ""
IF ZWasY$ <> "/" THEN _
ZUserIn$ = ZWasY$ : _
ZWasY$ = ZCarriageReturn$ : _
WasX$ = ZWasY$ : _
GOTO 1547
ZTurboKey = 0
GOTO 1525
* REPLACING old line(s) by new
1575 IF LEN(ZUserIn$) > 4000 THEN _
* ------[ first line different ]------
ZOutTxt$ = "Try Again, " + _
ZFirstName$ + ".": _ ' UG070501
ZSubParm = 5 : _
CALL TPut : _
IF ZSubParm = -1 OR ZFunctionKey <> 0 THEN _
EXIT SUB _
ELSE GOTO 1500
IF ZParseOff THEN _
ZParseOff = ZFalse : _
GOTO 1620
CALL ParseIt
IF ZWasQ = 1 THEN _
GOTO 1622
GOTO 1625
* REPLACING old line(s) by new
1628 CALL VerifyAns
IF NOT ZOK THEN _
* ------[ first line different ]------
CALL QuickTPut2 ("Sorry, Invalid Answer: " + ZUserIn$(1)) : _ ' UG070501
GOTO 1500
HoldA$ = ""
ZForceKeyboard = ZFalse
IF ZMacroSave > 0 THEN _
ZGSRAra$(ZMacroSave) = ZUserIn$ : _
ZMacroSave = 0 : _
GOTO 1632
IF (ZDistantTGet > 0) OR (ZMacroTemplate$ <> "") THEN _
CALL WipeLine (38) : _
IF NOT ZNo THEN _
GOTO 1632 _
ELSE ZWasQ = 0 : _
ZMacroTemplate$ = "" : _
ZDistantTGet = 0 : _
ZNo = ZFalse : _
GOTO 1633
IF ZMacroActive THEN _
ZLastIndex = ZWasQ : _
FirstIndex = 1: _
ZMacroActive = NOT EOF(6) : _
EXIT SUB
IF ZAnsIndex > 255 OR ((NOT InStack) AND INSTR(ZUserIn$,".") > 0) THEN _
EXIT SUB
IF MacroIndex OR ZSubParm < 3 THEN _
MacroIndex = 1 _
ELSE MacroIndex = ZAnsIndex
CALL NoPath (ZUserIn$(MacroIndex),Found)
IF Found THEN _
EXIT SUB
CALL CheckMacro (ZUserIn$(MacroIndex),Found)
IF Found THEN _
ZStoreParseAt = ZAnsIndex : _
GOTO 1525
EXIT SUB
* REPLACING old line(s) by new
1635 IF LEN(ZUserIn$) = 0 THEN _
GOTO 1525
ZUserIn$ = LEFT$(ZUserIn$,LEN(ZUserIn$)-1)
CALL LPrnt(ZLocalBksp$,0)
IF SendRemote THEN _
CALL PutCom(ZBackSpace$)
GOTO 1525
END SUB
* ------[ first line different ]------
SUB UglyTGet STATIC ' UG070501
CALL TGet ' UG070501
CALL SkipLine (1) ' UG070501
END SUB ' UG070501
* REPLACING old line(s) by new
1636 ' $SUBTITLE: 'RingCaller - sub to use sound + screen emphasis'
' $PAGE
'
' NAME -- RingCaller
'
' INPUTS -- PARAMETER MEANING
' ZOutTxt$ STRING TO EMPHASIZE
'
' OUTPUTS -- none
'
' PURPOSE -- Rings the users bell before and after string
' (but not snooping sysop) and adds emphasis around
' message sent.
'
SUB RingCaller STATIC
WasX$ = LEFT$(ZBellRinger$,-ZLocalUser)
CALL PutCom (ZBellRinger$)
CALL LPrnt (WasX$,0)
* ------[ first line different ]------
ZSubParm = 5 ' UG070501
ZOutTxt$ = ZEmphasizeOn$ + ZOutTxt$ + ZEmphasizeOff$
CALL TPut
CALL PutCom (ZBellRinger$)
CALL LPrnt (WasX$,0)
END SUB
* REPLACING old line(s) by new
1640 ZWasB = INSTR(ZWasA,ZUserIn$,ParseChar$)
ZWasC = ZWasB-ZWasA
IF ZWasC < 1 THEN _
ZEOL = ZTrue : _
ZWasC = 128
ZWasDF$ = MID$(ZUserIn$,ZWasA,ZWasC)
IF ZWasDF$ = "" THEN GOTO 1641
ZWasQ = ZWasQ + 1
ZStoreParseAt = ZStoreParseAt + 1
ZUserIn$(ZStoreParseAt) = ZWasDF$
CALL AllCaps(ZWasDF$)
WasX = INSTR(";NS;/G;C;",";"+ZWasDF$+";")
IF WasX = 0 THEN GOTO 1641
ZNonStop = ZNonStop OR (WasX = 1) OR (WasX = 7 AND NOT ZStackC)
IF ZStoreParseAt > 1 THEN IF INSTR("Jj",ZUserIn$(ZStoreParseAt-1)) THEN _
ZNonStop = (ZPageLength < 1)
ZAutoLogoffReq = ZAutoLogoffReq OR (WasX = 4)
* ------[ first line different ]------
IF ZAutoLogoffReq THEN CALL SkipLine (1) : CALL QuickTPut1 ("Auto-Logoff Requested.") ' UG070501
IF ZWasQ > 0 AND WasX < 7 THEN _
ZWasQ = ZWasQ - 1 : _
ZStoreParseAt = ZStoreParseAt - 1
* REPLACING old line(s) by new
1652 IF ZStoreParseAt > ZLastIndex THEN _
IF ZLastIndex > 0 THEN _
ZLastIndex = ZStoreParseAt
ZStackC = ZFalse
ZParseOff = ZFalse
END SUB
* ------[ first line different ]------
SUB UglyPopCmdStack STATIC ' UG070501
PromptDisplayed = (ZAnsIndex >= ZLastIndex) ' UG070501
CALL PopCmdStack ' UG070501
IF PromptDisplayed AND NOT ZMacroActive THEN _ ' UG070501
CALL SkipLine (1) ' UG070501
END SUB ' UG070501
* REPLACING old line(s) by new
* ------[ first line different ]------
2021 ZOutTxt$ = "To: A)ll,S)ysop," + _
LEFT$("D)istribution,",-14*EnableCC) + _
" or Name" + ZPressEnterExpert$ ' UG070501
' CALL SkipLine (1) ' UG070501
ZSemiOnly = ZTrue
CALL PopCmdStack
IF LEN(ZUserIn$(ZAnsIndex)) > 30 THEN _
CALL QuickTPut1 ("30 Chars Max.") : _ ' UG070501
GOTO 2021
Found = ZTrue
IF ZWasQ = 0 THEN _
GOTO 2033 _
ELSE ZWasDF$ = ZUserIn$(ZAnsIndex) : _
CALL AllCaps (ZWasDF$) : _
ZUserIn$(ZAnsIndex) = ZWasDF$ : _
IF ZWasDF$ = "A" THEN _
MsgTo$ = "ALL" _
ELSE IF ZWasDF$ = "S" THEN _
MsgTo$ = "SYSOP" _
ELSE IF ZWasDF$ = "D" AND EnableCC THEN _
GOTO 2025 _
ELSE MsgTo$ = ZUserIn$(ZAnsIndex) :_
CALL AllCaps (MsgTo$)
GOTO 2032
* REPLACING old line(s) by new
* ------[ first line different ]------
2025 ZOutTxt$ = "Use What Distribution List, H)elp" ' UG070501
CALL PopCmdStack
IF ZWasQ = 0 THEN _
GOTO 2021
ZFileName$ = ZUserIn$(ZAnsIndex)
CALL AllCaps (ZFileName$)
IF INSTR("?H",ZFileName$) > 0 THEN _
GOTO 2024
CALL BadFile (ZFileName$,BadFileNameIndex)
ON BadFileNameIndex GOTO 2026,2025,2025
* REPLACING old line(s) by new
2026 ZFileName$ = ZDistriPath$ + ZFileName$ + ".LST"
CALL FindItX (ZFileName$,7)
IF NOT ZOK THEN _
* ------[ first line different ]------
CALL QuickTPUT1 (ZUserIn$ + " Not Found.") : _ ' UG070501
GOTO 2024
ZNumHeaders = 0
CALL OpenWorkA (ZNodeWorkFile$)
WHILE NOT EOF(7)
CALL ReadDir (7,1)
CALL AllCaps (ZOutTxt$)
ZWasDF$ = ZOutTxt$
CALL WhoCheck (ZOutTxt$, Found, RcvrRecNum)
ZNumHeaders = ZNumHeaders + 1
CALL PrintWorkA (ZWasDF$ + "," + STR$(-RcvrRecNum*Found))
WEND
CLOSE 7
GOTO 2033
* REPLACING old line(s) by new
2032 RcvrRecNum = 0
IF MsgTo$ <> "ALL" THEN _
IF (LEFT$(MsgTo$,4) <> "ALL " AND ZStartHash = 1) THEN _
ZWasDF = INSTR(MsgTo$+" @"," @") : _
TempHashValue$ = LEFT$(MsgTo$,ZWasDF-1) : _
CALL WhoCheck (TempHashValue$,Found,RcvrRecNum) : _
IF NOT Found THEN _
ZLastIndex = 0 : _
RcvrRecNum = 0 : _
IF NOT ZReply THEN _
* ------[ first line different ]------
ZOutTxt$ = "Send it Anyway (Y,[N])" : _ ' UG070501
ZTurboKey = -ZTurboKeyUser : _
ZLastIndex = 0 : _
GOSUB 2034 : _
IF NOT ZYes THEN _
GOTO 2021
IF MsgTo$ = Temp$ THEN _
ZOutTxt$ = "Really Send This to Yourself (Y,[N])" : _ ' UG070501
ZLastIndex = 0 : _
GOSUB 2034 : _
IF NOT ZYes THEN _
MsgTo$ = ""
CALL OpenWorkA (ZNodeWorkFile$)
CALL PrintWorkA (MsgTo$ + "," + STR$(RcvrRecNum))
CLOSE 2
ZNumHeaders = ZNumHeaders + 1
IF EnableCC AND (NOT ZReply) AND MsgTo$ <> "ALL" AND _
MsgTo$ <> "" AND LEFT$(MsgTo$,4) <> "ALL " AND _
(NOT ZSysopComment) AND (NOT ZSysopMsg) THEN _
ZOutTxt$ = "Send Carbon Copies to Other Users (Y,[N])" : _' UG070501
CALL PopCmdStack : _
IF ZYes THEN _
GOTO 2021
* REPLACING old line(s) by new
* ------[ first line different ]------
2061 ZOutTxt$ = "Save as:" + ZOutTxt$ + " (E)dit More, H)elp" ' UG070501
IF MsgPswd$ = "^READ^" THEN _
DefaultProt$ = "R" : _
GOTO 2065
IF LEFT$(MsgPswd$,1) = "!" THEN _
DefaultProt$ = "P" _
ELSE _
DefaultProt$ = "U"
* REPLACING old line(s) by new
2075 IF MsgTo$ = "ALL" THEN _
* ------[ first line different ]------
CALL QuickTPut2 ("Message to ALL Can't Be Private.") : _ ' UG070501
GOTO 2060
IF ZWasZ$ = "P" THEN _
GOTO 2088
* REPLACING old line(s) by new
2081 CALL QuickTPut1 ("Sending Private Mail.") ' UG070501
* REPLACING old line(s) by new
* ------[ first line different ]------
2085 ZOutTxt$ = "Enter a Message Password" ' UG070501
GOSUB 2096
IF ZWasQ = 0 THEN _
IF LEFT$(MsgPswd$,1) = "!" THEN _
MsgPswd$ = MID$(MsgPswd$,2) : _
CALL QuickTPut1 ("Password is " + MsgPswd$ + ".") : _ ' UG070501
RETURN _
ELSE _
GOTO 2085
IF LEN(ZUserIn$) > WasL THEN _
CALL QuickTPut1 (MID$(STR$(WasL),2) + " Chars Max.") : _ ' UG070501
GOTO 2085
IF WasL = 15 AND LEFT$(ZUserIn$,1) = "!" THEN _
CALL QuickTPut1 ("Password Can't Begin with a '!'.") : _ ' UG070501
GOTO 2085
RETURN
'
' ** PASSWORD PROTECT MESSAGE (USERS WITH PASSWORD AND SYSOP CAN READ) *
'
* REPLACING old line(s) by new
* ------[ first line different ]------
2088 ZOutTxt$ = "The Recipients Must Know the Password. Really Use a Password (Y,[N])" ' UG070501
ZTurboKey = -ZTurboKeyUser
GOSUB 2096
IF NOT ZYes THEN _
GOTO 2070
WasL = 14
WasA1$ = "!"
GOSUB 2085
CALL AllCaps (ZUserIn$)
GOTO 2092
'
' ** MAKE MESSAGE KILL PROTECTED (ONLY SENDER, ADDRESSEE AND SYSOP CAN KILL) *
'
* REPLACING old line(s) by new
2094 ZSubParm = 1
* ------[ first line different ]------
CALL UglyTGet ' UG070501
* REPLACING old line(s) by new
* ------[ first line different ]------
2096 CALL UglyPopCmdStack ' UG070501
GOTO 2095
END SUB
* REPLACING old line(s) by new
2250 ' $SUBTITLE: 'WhoCheck - Checks whether user exists'
' $PAGE
'
' NAME -- WhoCheck
'
' INPUTS -- PARAMETER MEANING
' WhoFind$ User to find
'
' OUTPUTS -- WhoFound Whether user found
' UserNumFound Record # of user
'
' PURPOSE -- Validate that user record exists. Sysop
' counted as found even if lack user record.
'
SUB WhoCheck (WhoFind$,WhoFound,UserNumFound) STATIC
UserNumFound = 0
IF ZStartHash <> 1 THEN _
WhoFound = ZTrue : _
EXIT SUB
Work128$ = ZUserRecord$
WhoFound = ZFalse
ToSysop = (INSTR(WhoFind$,"SYSOP") > 0 OR _
INSTR(WhoFind$,ZSysopFirstName$ + " " + ZSysopLastName$) > 0)
CALL OpenUser (HighestUserRecord)
FIELD 5, 128 AS ZUserRecord$
IF ToSysop THEN _
WasX$ = ZSecretName$ _
ELSE WasX$ = WhoFind$
ZWasDF = INSTR(WasX$+"@","@")
WasX$ = LEFT$(WasX$,ZWasDF)
IF LEN(WasX$) > 1 THEN _
CALL FindUser (WasX$,"",ZStartHash,ZLenHash,_
0,0,HighestUserRecord,WhoFound,_
UserNumFound,ZWasSL)
LSET ZUserRecord$ = Work128$
IF NOT WhoFound THEN _
IF ToSysop THEN _
WhoFound = ZTrue _
* ------[ first line different ]------
ELSE CALL QuickTPut1 (WhoFind$ + " Isn't a User On This BBS.") ' UG070501)
END SUB
* REPLACING old line(s) by new
2620 ZOutTxt$ = "Line #" + _
STR$(WasL) + _
" is:" + _
ZReturnLineFeed$ + _
ZOutTxt$(WasL)
ZSubParm = 3
CALL TPut
GOSUB 2695
* ------[ first line different ]------
' IF NOT ZExpertUser THEN _ ' UG070501
' CALL QuickTPut1 ("Search & replace") ' UG070501
ZOutTxt$ = "Search for What String" + _ ' UG070501
ZPressEnterExpert$
ZMacroMin = 99
ZParseOff = ZTrue
ZSubParm = 1
GOSUB 2694
IF ZWasQ = 0 THEN _
CALL SkipLine (1) : _ ' UG070501
EXIT SUB
ZWasY$ = LEFT$(ZUserIn$,1)
IF ZWasY$ = RIGHT$(ZUserIn$,1) THEN _
IF LEN(ZUserIn$) > 2 THEN _
WasX = INSTR(2,ZUserIn$,ZWasY$) : _
IF WasX < LEN(ZUserIn$) THEN _
IF ZWasY$ < "0" OR (ZWasY$ > "9" AND ZWasY$ < "A") THEN _
ZUserIn$ = MID$(ZUserIn$,2,LEN(ZUserIn$)-2) : _
WasX = WasX - 1 : _
GOTO 2622
WasX = INSTR(ZUserIn$,";")
* REPLACING old line(s) by new
2622 IF WasX > 0 THEN _
WasX$ = LEFT$(ZUserIn$,WasX-1) : _
ZWasY$ = RIGHT$(ZUserIn$,LEN(ZUserIn$)-WasX) : _
GOTO 2660
WasX$ = ZUserIn$
* ------[ first line different ]------
ZOutTxt$ = "And Replace With What" ' UG070501
ZParseOff = ZTrue
ZSubParm = 1
ZMacroMin = 99
GOSUB 2694
ZWasY$ = ZUserIn$
* REPLACING old line(s) by new
2660 WasX = INSTR(1,ZOutTxt$(WasL),WasX$)
* ------[ first line different ]------
CALL SkipLine (1) ' UG070501
IF WasX = 0 THEN _ ' UG070501
CALL QuickTPut2 ("String Not Found in Line" + STR$(WasL) + ".") : _ ' UG070501
GOTO 2620
* REPLACING old line(s) by new
3955 IF WasQX > ActiveMessages THEN _
* ------[ first line different ]------
ZOutTxt$ = "Message #" + _
STR$(MsgToKill) + " Not Found." : _ ' UG070501
GOTO 4031
IF ZMsgPtr(WasQX,2) = MsgToKill AND MsgToKill => 1 THEN _
GOTO 3970
WasQX = WasQX + 1
GOTO 3955
* REPLACING old line(s) by new
3990 IF ZWasZ$ = "^READ^" OR ZWasZ$ = "^KILL^" THEN _
CALL ChkMsgName (MsgFromCaller,MsgToCaller) : _
IF (MsgFromCaller OR MsgToCaller) THEN _
GOTO 4020 _
ELSE IF NumHeaders > 1 THEN _
GOTO 4032 _
ELSE ZMsgPswd = ZTrue : _
ZAttemptsAllowed = 0 : _
* ------[ first line different ]------
ZOutTxt$ = "Only the Sender and Receiver Can Kill Message #" + STR$(MsgToKill) + "." : _ ' UG070501
GOTO 4031
* REPLACING old line(s) by new
4020 ZWasZ$ = MID$(ZMsgRec$,37,22)
CALL Trim (ZWasZ$)
IF OrigNumHeaders < 2 AND ZExpertUser THEN _
GOTO 4030
* ------[ first line different ]------
ZOutTxt$ = "Really Kill Message #" + STR$(MsgToKill) + " to " + ZWasZ$ + " ([Y],N)" ' UG070501
ZSubParm = 1
ZTurboKey = -ZTurboKeyUser
CALL TGet
IF ZSubParm < 0 THEN _
EXIT SUB
IF ZNo THEN _
GOTO 4032
* REPLACING old line(s) by new
4030 ZSubParm = 3
CALL FileLock
GET 1, MsgRec
MID$(ZMsgRec$,116,1) = ZDeletedMsg$
PUT 1, MsgRec
ZSubParm = 4
CALL FileLock
* ------[ first line different ]------
ZOutTxt$ = "Killed Message #" + _
STR$(MsgToKill) + " to " + ZWasZ$ + "." ' UG070501
CALL UpdtCalr (ZOutTxt$,1)
IF ((ZUserSecLevel < ZSecKillAny) AND NOT MsgFromCaller) THEN _
NumHeaders = 0
* REPLACING old line(s) by new
* ------[ first line different ]------
4656 ZOutTxt$ = "Thread: +)Forward, -)Back, 1)From Start" + ZPressEnterExpert$ ' UG070501
ZTurboKey = -ZTurboKeyUser
ZSubParm = 1
CALL UglyTGet ' UG070501
IF ZWasQ = 0 OR ZSubParm = -1 THEN _
EXIT SUB
ZWasZ$ = ZUserIn$(1)
* REPLACING old line(s) by new
4777 ZWasCM = 0
CALL CheckTime(TimeChatStarted!,Elapsed!, 2)
ZSecsPerSession! = ZSecsPerSession! + Elapsed!
IF NOT ZLocalUser THEN _
ZAutoLogoff! = TIMER + ZWaitBeforeDisconnect
* ------[ first line different ]------
CALL QuickTPut2 (ZCrLf$ + "Chat Ended. Returning You to the BBS.") ' UG070501
END SUB
* REPLACING old line(s) by new
5501 CALL TimeRemain(MinsRemaining)
* ------[ first line different ]------
ZOutTxt$ = "You Have" + STR$(MinsRemaining) + _
" Minutes Left. D)eposit, W)ithdraw, H)elp, [Q]uit" ' UG070501
ZTurboKey = -ZTurboKeyUser ' UG070501
CALL UglyPopCmdStack ' UG070501
IF ZSubParm = -1 THEN _
EXIT SUB
ZWasZ$ = LEFT$(ZUserIn$(ZAnsIndex),1)
CALL AllCaps(ZWasZ$)
ON INSTR("QDW?H",ZWasZ$) GOTO 5509,5505,5502,5508,5508
GOTO 5501
* REPLACING old line(s) by new
5503 IF SignTime = 1 THEN _
ZOutTxt$ = "Withdraw" _
ELSE ZOutTxt$ = "Deposit"
* ------[ first line different ]------
Temp$ = ZOutTxt$ + " How Many Minutes" ' UG070501
CALL ChangeInt (ZFalse,Temp$,Temp,0,Maxtime)
IF ZWasQ = 0 OR ZTestedIntValue = 0 THEN _
GOTO 5501
ZTestedIntValue = SignTime * ZTestedIntValue
CALL ChkAddedTime (ZTestedIntValue)
IF ZTestedIntValue = 0 THEN _
GOTO 5501
ZSecsPerSession! = ZSecsPerSession! + (ZTestedIntValue * 60)
ZElapsedTime = ZElapsedTime - ZTestedIntValue
ZGlobalBankTime = ZGlobalBankTime - ZTestedIntValue
GOSUB 5507
GOTO 5501
* REPLACING old line(s) by new
5505 SignTime = -1 ' deposit
MaxTime = ZMaxBank - ZGlobalBankTime
IF MaxTime <= 0 THEN _
* ------[ first line different ]------
CALL QuickTPut2 ("Sorry, You've Already Deposited the Maximum Time of" + STR$(ZMaxBank) + " Minutes.") : _ ' UG070501
ZLastIndex = 0 : _
GOTO 5501
IF MaxTime > MinsRemaining THEN _
MaxTime = MinsRemaining
GOTO 5503
* REPLACING old line(s) by new
5507 IF ZAnsIndex < ZLastIndex THEN _
RETURN
* ------[ first line different ]------
ZOutTxt$ = "Current Bank Balance:" + _
STR$(ZGlobalBankTime) + " Minutes." ' UG070501
CALL QuickTPut1(ZOutTxt$)
RETURN
* REPLACING old line(s) by new
5509 GOSUB 5507
* ------[ first line different ]------
CALL SkipLine (1) ' UG070501
END SUB ' SKO10601
* REPLACING old line(s) by new
9801 ' $SUBTITLE: 'WhosOn - subroutine to display who is on'
' $PAGE
'
' NAME -- WhosOn
'
' INPUTS -- PARAMETER MEANING
' NumNodes # of nodes to check
' ZActiveMessageFile$ Current message file
' ZOrigMsgFile$ Main msg file
'
' OUTPUTS -- None
'
' PURPOSE -- To display who is on each node.
'
SUB WhosOn (NumNodes) STATIC
WasA1$ = ZActiveMessageFile$
ZActiveMessageFile$ = ZOrigMsgFile$
CALL OpenMsg
FIELD 1, 128 AS ZMsgRec$
FOR NodeIndex = 2 TO NumNodes + 1
GET 1,NodeIndex
ZOutTxt$ = ZFG1$ + "Node" + _
STR$(NodeIndex - 1) + ZFG2$
RecIndex = -VAL(MID$(ZMsgRec$,44,2))
IF RecIndex >= 0 THEN _
RecIndex = -1
WasAX$ = MID$(ZBaudRates$,(-5 * RecIndex ),5) + _
" BPS: "
IF MID$(ZMsgRec$,55,2) = "-1" AND NOT ZSysop THEN _
* ------[ first line different ]------
ZWasY$ = "SysOp" + SPACE$(21) _ ' UG070501
ELSE ZWasY$ = MID$(ZMsgRec$,1,26)
WasAX$ = WasAX$ + ZFG3$ + ZWasY$
IF MID$(ZMsgRec$,40,2) <> "-1" THEN _
WasAX$ = WasAX$ + ZFG4$ + MID$(ZMsgRec$,93,22)
IF MID$(ZMsgRec$,57,1) = "A" THEN _
ZOutTxt$ = ZOutTxt$ + " Online at " + _
WasAX$ _
ELSE IF NOT ZSysop THEN _
ZOutTxt$ = ZOutTxt$ + _
" Waiting for a Caller" _ ' UG070501
ELSE ZOutTxt$ = ZOutTxt$ + _
" Offline at " + _
WasAX$
CALL QuickTPut1 (ZOutTxt$)
CALL AskMore ("",ZTrue,ZTrue,ZAnsIndex,ZFalse)
IF ZNo THEN _
NodeIndex = NumNodes + 2
NEXT
ZActiveMessageFile$ = WasA1$
CALL QuickTPut1 (ZEmphasizeOff$) ' UG070501
END SUB
* REPLACING old line(s) by new
10420 GET 1,MsgRec
NumRecsInMsg = VAL(MID$(ZMsgRec$,117,4))
IF NumRecsInMsg < 1 OR MsgRec => ZNextMsgRec THEN _
* ------[ first line different ]------
ZWasY$ = "Unknown Message #" + _ ' UG070501
STR$(MsgToRecover) : _
GOTO 10485
* REPLACING old line(s) by new
10450 IF INSTR(ZMsgRec$,ZDeletedMsg$) <> 0 THEN _
LSET ZMsgRec$ = LEFT$(ZMsgRec$,115) + _
ZActiveMessage$ + _
MID$(ZMsgRec$,117) : _
PUT 1,LOC(1) : _
* ------[ first line different ]------
ZWasY$ = "Message #" + _
STR$(MsgToRecover) + " Restored.": _ ' UG070501
ActionFlag = ZTrue : _
GOTO 10485
* REPLACING old line(s) by new
* ------[ first line different ]------
10480 ZWasY$ = "Sorry, Message #" + _
STR$(MsgToRecover) + _
" Isn't Dead." ' UG070501
* REPLACING old line(s) by new
* ------[ first line different ]------
10485 CALL QuickTPut2 (ZWasY$) ' UG070501
END SUB
* REPLACING old line(s) by new
10607 IF ZExitToDoors OR NOT LoggingOff THEN _
EXIT SUB
Temp = ZMinsPerSession
IF ZMaxPerDay > 0 THEN _
Temp = ZMaxPerDay - TempElapsed! : _
IF Temp > ZMinsPerSession THEN _
Temp = ZMinsPerSession
Temp = -(Temp > 0) * Temp
* ------[ first line different ]------
CALL QuickTPut1 ("You Have" + STR$(Temp)+" Minutes Left for Today.") ' UG070501
ZOutTxt$ = ZFirstName$ ' UG070501
CALL NameCaps(ZOutTxt$) ' UG070501
CALL QuickTPut1 (ZOutTxt$ + ", Thanks for Calling. Please Call Again!") ' UG070501
IF NOT ZHiLiteOff THEN _
CALL QuickTPut1 (ZColorReset$)
CALL DelayTime (8 + ZBPS)
END SUB
* REPLACING old line(s) by new
10950 CALL AMorPM
CALL UpdtCalr ("Exited to DOS at " + ZTime$,2)
* ------[ first line different ]------
CALL QuickTPut1 ("RBBS-PC " + ZVersionID$ + " Remote DOS Jump. Type EXIT to Return." ) ' UG070501
' CALL QuickTPut1 ("SysOp in Remote Console mode") ' UG070501
CALL RBBSExit (ZOutTxt$(),ZFF)
END SUB
* REPLACING old line(s) by new
10985 CALL ReadParms (ZOutTxt$(),8,1)
IF ZErrCode > 0 THEN _
IF ReqDoorsDef THEN _
EXIT SUB _
ELSE ExitTo$ = ExitTo$ + " " + ZNodeID$ : _
GOTO 10989
IF ExitTo$ <> ZOutTxt$(1) THEN _
GOTO 10985
CALL CheckInt (ZOutTxt$(2))
IF ZErrCode > 0 THEN _
ZErrCode = 0 : _
GOTO 10985
IF ZUserSecLevel < ZTestedIntValue THEN _
* ------[ first line different ]------
CALL QuickTPut2 ("Sorry, You Need a Higher Security Level for this Door.") : _ ' UG070501
EXIT SUB
WasX$ = LEFT$(ZOutTxt$(5),INSTR(ZOutTxt$(5)+" "," ")-1)
CALL FindIt (WasX$)
IF NOT ZOK THEN _
GOTO 10986
ZFileName$ = ZOutTxt$(3)
ExitMethod$ = ZOutTxt$(4)
ExitTemplate$ = ZOutTxt$(5)
ZDoorDisplay$ = ZOutTxt$(7)
ZDoorTime$ = ZOutTxt$(8)
CALL AskUsers
CALL SmartText (ExitTemplate$,ZFalse,ZFalse)
CALL MetaGSR (ExitTemplate$,ZFalse)
ExitTo$ = ExitTemplate$
GOTO 10989
* REPLACING old line(s) by new
10989 IF ZTransferFunction = 3 THEN _
ZWasY$ = "Registration" _
ELSE ZWasY$ = ZDooredTo$
* ------[ first line different ]------
' ZOutTxt$ = ZWasY$ + _ ' UG070501
' " door opened at " + _ ' UG070501
' TIME$ + _ ' UG070501
' " on " + _ ' UG070501
' DATE$ ' UG070501
' ZSubParm = 5 ' UG070501
' CALL TPut ' UG070501
CALL QuickTPut1 ("Loading " + ZWasY$ + " Door. Please Wait...") ' UG070501
CALL UpdtCalr (ZDooredTo$ + " door opened!",2)
CALL DoorInfo
IF ExitMethod$ = "S" THEN _
CALL UpdateU (ZFalse) : _
CLOSE 4,5 : _
CALL ShellExit (ExitTemplate$) : _
ZPrevCaller$ = "" : _
CALL SetCall : _
ZExitToDoors = ZTrue : _
CALL DoorReturn : _
CALL BufFile (ZDoorDisplay$,WasX) : _
ZExitToDoors = ZFalse _
ELSE ZOutTxt$(1) = ZDiskForDos$ + _
"COMMAND /C " + _
ExitTo$ : _
ZOutTxt$(2) = ZRBBSBat$ : _
CALL RBBSExit (ZOutTxt$(),2)
END SUB
* REPLACING old line(s) by new
10991 ' $SUBTITLE: 'DoorInfo -- Write info for doors to file'
SUB DoorInfo STATIC
CLOSE 2
OPEN "O",2,"DORINFO" + _
ZNodeFileID$ + _
".DEF"
PRINT #2,ZRBBSName$
PRINT #2,ZSysopFirstName$
PRINT #2,ZSysopLastName$
IF ZLocalUser THEN _
PRINT #2,"COM0" _
ELSE PRINT #2,ZComPort$
* ------[ first line different ]------
ZUserIn$ = MID$(ZBaudParity$, INSTR(ZBaudParity$, " BPS")+4) ' UG070511
PRINT #2,ZTalkToModemAt$;" BAUD";ZUserIn$
PRINT #2,ZNetworkType
IF ZGlobalSysop THEN _
PRINT #2,"SYSOP" : _
PRINT #2,"" _
ELSE PRINT #2,ZFirstName$ : _
PRINT #2,ZLastName$
PRINT #2,ZCityState$
PRINT #2,ZWasGR
PRINT #2,ZUserSecLevel
CALL TimeRemain (MinsRemaining)
CALL CheckInt (ZDoorTime$)
IF ZErrCode = 0 AND ZTestedIntValue > 0 THEN _
IF MinsRemaining > ZTestedIntValue THEN _
MinsRemaining = ZTestedIntValue
PRINT #2,INT(MinsRemaining)
PRINT #2,ZFossil
CLOSE 2
END SUB
* REPLACING old line(s) by new
12025 ZActiveMenu$ = LEFT$(ZSection$,1)
LSET ZLastCommand$ = ZActiveMenu$ + " "
IF ZShowSection THEN _
ZSectionPrompt$ = ZSection$ _
ELSE ZSectionPrompt$ = "Your"
IF ZCmndsInPrompt=0 THEN _
ZSectionOpts$ = ""
ZCmdPrompt$ = ZSectionPrompt$ + _
* ------[ first line different ]------
" Command" + _ ' UG070501
ZSectionOpts$
END SUB
* REPLACING old line(s) by new
12880 ZParseOff = ZTrue
ZOutTxt$ = Ques$
* ------[ first line different ]------
CALL UglyPopCmdStack ' UG070501
IF ZSubParm = -1 THEN _
GOTO 12882
IF ZWasQ = 0 THEN _
GOTO 12880
IF LEN(ZUserIn$(ZAnsIndex)) > MaxLen THEN _
ZLastIndex = 0 : _
CALL QuickTPut1 (MID$(STR$(MaxLen),2) + " Chars Max.") : _ ' UG070501
GOTO 12880_
ELSE IF LEN(ZUserIn$(ZAnsIndex)) < MinLen THEN _
ZLastIndex = 0 : _
CALL QuickTPut1 (MID$(STR$(MinLen),2) + " Chars Min.") ' UG070501: _
GOTO 12880
Ans$ = ZUserIn$(ZAnsIndex)
IF ZAnsIndex < ZLastIndex THEN _
GOTO 12881
ZOutTxt$ = "You Entered " + ZUserIn$(ZAnsIndex) + _
", Right ([Y],N)" ' UG070501
ZTurboKey = -ZTurboKeyUser
ZSubParm = 1
CALL UglyTGet ' UG070501
IF ZSubParm = -1 THEN _
GOTO 12882
IF ZNo THEN _
GOTO 12880
* REPLACING old line(s) by new
20096 ' $SUBTITLE: 'CheckRatio - subroutine to print ul/dl ratio'
' $PAGE
'
' NAME -- CheckRatio
'
' INPUTS -- PARAMETER MEANING
' TellUser TELL USER THEIR RATIO
' ZDnlds FILES DOWNLOADED
' ZDLBytes! BYTES DOWNLOADED
' ZUplds FILES UPLOADED
' ZULBytes! BYTES UPLOADED
'
' OUTPUTS -- ZOK -1 if okay to download, 0 otherwise
'
' PURPOSE -- To determine whether the users violated
' their upload to download restriction
'
SUB CheckRatio (TellUser) STATIC
ZOK = ZTrue
IF ZRatioRestrict# <= 0 OR (NOT ZEnforceRatios) OR ZFreeDnld THEN _
GOTO 20110
'
' Detemine method of ratio checking. Look ahead to amount downloaded
'
IF ZByteMethod = 1 OR ZByteMethod = 3 THEN _
Method$ = "Bytes" : _
ULWork# = ZULBytes! : _
DLWork# = ZDLBytes! + ZNumDnldBytes!
IF ZByteMethod = 0 OR ZByteMethod = 2 THEN _
Method$ = "Files" : _
ULWork# = ZUplds : _
DLWork# = ZDnlds + ZDownFiles
IF ULWork# < ZInitialCredit# THEN _
ULWork# = ZInitialCredit#
IF ZByteMethod = 2 THEN _
Today# = ZRatioRestrict# - ZDLToday! - ZDownFiles
IF ZByteMethod = 3 THEN _
Today# = ZRatioRestrict# - ZBytesToday! - ZNumDnldBytes!
'
Ratio# = 0
RatioSuffix$ = ":0"
IF ULWork# > 0 THEN _
Ratio# = (DLWork# / ULWork#) : _
RatioSuffix$ = ":1"
IF ZByteMethod > 1 THEN _
* ------[ first line different ]------
ZOutTxt$ = "Today: Files Downloaded:" + STR$(ZDLToday! + ZDownFiles) + _
" " + STR$(ZBytesToday! + ZNumDnldBytes!) + " Bytes.": _ ' UG070501
ZSubParm = 5 : _
CALL TPut : _ ' UG070501
GOTO 20100
WasX$ = STR$(Ratio#)
X = INSTR(WasX$,".")
IF X > 0 THEN _
WasX$ = LEFT$(WasX$,X+1)
ZOutTxt$ = "Total " + Method$ + " Downloaded:" + STR$(DLWork#) + _
" Uploaded:" + _
STR$(ULWork#) + _
" Ratio:" + _ ' UG070501
WasX$ + _
RatioSuffix$
ZSubParm = 5
CALL TPut
'
' CHECK TO SEE IF THE USER HAS VIOLATED THEIR UL/DL RESTRICTION
'
* REPLACING old line(s) by new
20100 IF NOT (ZRatioRestrict# > 0 AND TellUser) THEN _
EXIT SUB
IF ZByteMethod <= 1 THEN _
GOTO 20105
IF Today# < 0 THEN _
* ------[ first line different ]------
ZOutTxt$ = "Sorry, Daily Download Limit of" + _
STR$(ZRatioRestrict#) + " " + _
Method$ + " Reached." : _ ' UG070501
ZOK = ZFalse _
ELSE ZOutTxt$ = "Download Balance:" + _ ' UG070501
STR$(Today#) + _
" " + _
Method$ : _
ZOK = ZTrue
ZSubParm = 1 ' UG070501
CALL TPut
' CALL SkipLine(1) ' UG070501
EXIT SUB
'
* REPLACING old line(s) by new
20105 IF Ratio# > ZRatioRestrict# OR ULWork# = 0 THEN _
ZOK = ZFalse : _
* ------[ first line different ]------
ZOutTxt$ = "Sorry, DL/UL Ratio of" + _ ' UG070501
STR$(ZRatioRestrict#) + _
":1 " + _
Method$ + " Exceeded." : _ ' UG070501
ZSubParm = 1 : _ ' UG070501
CALL TPut : _
ZOutTxt$ = "Minimum Upload of" + _ ' UG070501
STR$(INT(((DLWork# - (ULWork# * ZRatioRestrict#)) _
/ ZRatioRestrict#) + 1)) + _
+ " " + Method$ + " is Required to Download." _ ' UG070501
ELSE ZOutTxt$ = "Balance Remaining Before Upload Required:" + _ ' UG070501
STR$(INT((ULWork# * ZRatioRestrict#)-DLWork#)) + _
" " + Method$
ZSubParm = 5
CALL TPut
' CALL SkipLine (1) ' UG070501
* REPLACING old line(s) by new
20141 IF ZAnsIndex >= ZLastIndex THEN _
IF LEN(ZDefaultExtension$) > 0 THEN _
* ------[ first line different ]------
CALL QuickTPut1 ("Default Extension is ."+ZDefaultExtension$) ' UG070501
WasZ$ = "V"
CALL AskItems ("V",WasZ$,ZFalse,"Compressed File",ZMarkedFiles$) ' UG070501
IF ZSubParm = -1 OR ZWasQ = 0 THEN _
EXIT SUB
ZViolation$ = "View ARC"
WasX = ZAnsIndex
ZAnsIndex = WasX
* REPLACING old line(s) by new
* ------[ first line different ]------
20143 CALL AllCaps (ZUserIn$(ZAnsIndex)) ' UG070501
ZWasZ$ = ZUserIn$(ZAnsIndex) ' UG070501
CALL UnMarkItems (ZMarkedFiles$,ZAnsIndex, ZLastIndex,Temp,ZFalse)
ZWasZ$ = ZUserIn$(ZAnsIndex)
WasZ$ = ZWasZ$
CALL AllCaps (ZWasZ$)
CALL BreakFileName (ZWasZ$,Drive$,Prefix$,Ext$,ZFalse)
IF Ext$ = "" THEN _
Ext$ = ZDefaultExtension$ : _
ZWasZ$ = ZWasZ$ + "." + ZDefaultExtension$
ZFileNameHold$ = ZWasZ$
ZFileName$ = ZWasZ$
CALL BadFile (Prefix$,BadFileNameIndex)
ON BadFileNameIndex GOTO 20144,20146,20147
* REPLACING old line(s) by new
20146 ZWasZ$ = WasZ$ + _
* ------[ first line different ]------
" Not Found." ' UG070501
CALL UpdtCalr (ZWasZ$,2)
ZOutTxt$ = ZWasZ$ + _
" Enter the Correct Filename" + ZPressEnterExpert$ ' UG070501
ZSubParm = 1 ' UG070501
CALL UglyTGet ' UG070501
IF ZSubParm = -1 OR ZWasQ = 0 THEN _
RETURN
ZUserIn$(ZAnsIndex) = ZUserIn$(1)
GOTO 20143
* REPLACING old line(s) by new
20150 WasX = INSTR(".ARC.PAK.ZIP.LZH.","."+Ext$+".")
'IF (WasX < 1) OR (WasX = 1 AND NOT ZTurboRBBS) THEN _
IF (WasX < 1) THEN _
* ------[ first line different ]------
CALL QuickTPut2 ("Sorry, View for ."+Ext$+"s is Unavailable.") : _ ' UG070501
RETURN ' UG070501
' CALL QuickTPut1 (ZFileNameHold$ + " has these files") ' UG070501
CALL ViewArc
RETURN
END SUB